home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / HTMLmove / Convertr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-01  |  6.8 KB  |  241 lines
  1. unit Convertr;
  2. { $DEFINE DEBUG}
  3. interface
  4.  
  5. uses Classes, SysUtils, NewParse, HtmlTool;
  6.  
  7. type
  8.   THtmlFileMover = class(THtmlParser)
  9.   protected
  10.     FDestPath: string;
  11.     FSrcPath: string;
  12.     FNoChangeList: TStringList;
  13.     Source, Dest: TStream;
  14.     OutStr: string;
  15.     Line, Position: Integer;
  16.     function CorrectLink(S: String): string; virtual;
  17.     function MakeTagLegal(S: String): string; virtual;
  18.   public
  19.     constructor CreateNew(SSource, SDest: TStream); virtual;
  20.     destructor Destroy; override;
  21.     procedure Convert; virtual;
  22.     property DestPath: string read FDestPath write FDestPath;
  23.     property SrcPath: string read FSrcPath write FSrcPath;
  24.     property NoChangeList: TStringList read FNoChangeList write FNoChangeList;
  25.   end;
  26.  
  27.   THtmlFileCorrector = class(THtmlFileMover)
  28.   protected
  29.     FOldLinks: TStringList;
  30.     function CorrectLink(S: String): string; override;
  31.   public
  32.     constructor CreateNew(SSource, SDest: TStream); override;
  33.     destructor Destroy; override;
  34.     procedure Convert; override;
  35.     property OldLinks: TStringList read FOldLinks write FOldLinks;
  36.   end;
  37.  
  38.   {$IFDEF DEBUG}
  39. var
  40.   Log1: TextFile;
  41.   {$ENDIF}
  42.  
  43. implementation
  44.  
  45. { ******* class THtmlFileMover ******* }
  46. constructor THtmlFileMover.CreateNew(SSource, SDest: TStream);
  47. begin
  48.   inherited Create(SSource);
  49.   FNoChangeList := TStringList.Create;
  50.   Source := SSource;
  51.   Dest := SDest;
  52.   SetLength(OutStr, 10000);
  53.   OutStr := '';
  54. end;
  55.  
  56. destructor THtmlFileMover.Destroy;
  57. begin
  58.   FNoChangeList.Free;
  59.   inherited Destroy;
  60. end;
  61.  
  62. function THtmlFileMover.CorrectLink(S: string): string;
  63. var
  64.   AbsPath, NewRelPath: string;
  65. begin
  66.   Result := '';
  67.   AppendStr(Result, Copy(S, 0, Pos('"', S)));
  68.   // convert link to abs path relative to the source file
  69.   AbsPath := RelToAbsPath(SrcPath, UnixToDosPath(
  70.     Copy(S, Pos('"', S)+1, Length(S))));
  71.   // convert the link to a relative path based on where
  72.   // the file will be after the move
  73.   NewRelPath := AbsToRelPath(DestPath, AbsPath);
  74.   AppendStr(Result, NewRelPath);
  75.   Result := DosToUnixPath(Result);
  76. end;
  77.  
  78. function THtmlFileMover.MakeTagLegal(S: String): string;
  79. begin
  80.   if Token = toOpenTag then Result := '<'
  81.   else Result := '</';
  82.   AppendStr(Result, S);
  83.   AppendStr(Result, '>');
  84.   if Token = toOpenTag then Position := Position + 2
  85.   else Position := Position + 3;
  86. end;
  87.  
  88. procedure THtmlFileMover.Convert;
  89.  
  90.   function InList(AName: string): boolean;
  91.   var
  92.     i: integer;
  93.   begin
  94.     Result := false;
  95.     for i := 0 to FNoChangeList.Count-1 do
  96.       if Pos(uppercase(ExtractFileName(FNoChangeList[i])), uppercase(AName)) <> 0 then
  97.       begin
  98.         Result := true;
  99.         Exit;
  100.       end;
  101.   end;
  102.  
  103. begin
  104.   Line := 1;
  105.   Position := 0;
  106.   // parse the entire source file
  107.   while Token <> toEOF do
  108.   begin
  109.     // if the source code line has changed,
  110.     // add the proper newline character
  111.     while SourceLine > Line do
  112.     begin
  113.       AppendStr(OutStr, #13#10);
  114.       Inc(Line);
  115.       Position := Position + 2; // 2 characters, cr+lf
  116.     end;
  117.     // add proper white spaces (formatting)
  118.     while SourcePos > Position do
  119.     begin
  120.       AppendStr(OutStr, ' ');
  121.       Inc(Position);
  122.     end;
  123.     // check the token
  124.     case Token of
  125.       toSymbol: AppendStr(OutStr, TokenString);
  126.       toInteger: AppendStr(OutStr, TokenString);
  127.       toFloat: AppendStr(OutStr, TokenString);
  128.       toOpenTag: if (((Pos('A HREF="', UpperCase(TokenString)) > 0) or
  129.           (Pos('IMG SRC="', UpperCase(TokenString)) > 0) or
  130.             (Pos('BODY BACKGROUND="', UpperCase(TokenString)) > 0)) and (not
  131.               ((Pos('MAILTO', UpperCase(TokenString)) > 0) or
  132.                 (Pos('HTTP', UpperCase(TokenString)) > 0) or
  133.                   (Pos('NEWS', UpperCase(TokenString)) > 0) or
  134.                     InList(TokenString)))) then
  135.               AppendStr(OutStr, MakeTagLegal(CorrectLink(TokenString)))
  136.               else AppendStr(OutStr, MakeTagLegal(TokenString));
  137.       toCloseTag: AppendStr(OutStr, MakeTagLegal(TokenString));
  138.       else AppendStr(OutStr, Token);
  139.     end; // case Token of
  140.     // increase the current position
  141.     Position := Position + Length(TokenString);
  142.     // move to the next token
  143.     NextToken;
  144.   end;
  145.   // add the string to the stream
  146.   Dest.WriteBuffer(Pointer(OutStr)^, Length(OutStr));
  147. end;
  148.  
  149. { ******* class THtmlFileCorrector ******* }
  150. constructor THtmlFileCorrector.CreateNew(SSource, SDest: TStream);
  151. begin
  152.   inherited CreateNew(SSource, SDest);
  153.   FOldLinks := TStringList.Create;
  154. end;
  155.  
  156. destructor THtmlFileCorrector.Destroy;
  157. begin
  158.   FOldLinks.Free;
  159.   inherited Destroy;
  160. end;
  161.  
  162. function THtmlFileCorrector.CorrectLink(S: string): string;
  163. var
  164.   AbsPath, NewRelPath: string;
  165. begin
  166.   Result := '';
  167.   AppendStr(Result, Copy(S, 0, Pos('"', S)));
  168.   // convert link to abs path relative to the source file
  169.   AbsPath := RelToAbsPath(SrcPath, ExtractFileName(
  170.     UnixToDosPath(Copy(S, Pos('"', S)+1, Length(S)))));
  171.   // convert the link to a relative path based on where
  172.   // the file will be after the move
  173.   NewRelPath := AbsToRelPath(DestPath, AbsPath);
  174.   AppendStr(Result, NewRelPath);
  175.   Result := DosToUnixPath(Result);
  176. end;
  177.  
  178. procedure THtmlFileCorrector.Convert;
  179.  
  180.   function InList(AName: string): boolean;
  181.   var
  182.     i: integer;
  183.   begin
  184.     Result := false;
  185.     for i := 0 to FOldLinks.Count-1 do
  186.       if Pos(uppercase(ExtractFileName(FOldLinks[i])), uppercase(AName)) <> 0 then
  187.       begin
  188.         Result := true;
  189.         Exit;
  190.       end;
  191.   end;
  192.  
  193. begin
  194.   Line := 1;
  195.   Position := 0;
  196.   // parse the entire source file
  197.   while Token <> toEOF do
  198.   begin
  199.     // if the source code line has changed,
  200.     // add the proper newline character
  201.     while SourceLine > Line do
  202.     begin
  203.       AppendStr(OutStr, #13#10);
  204.       Inc(Line);
  205.       Position := Position + 2; // 2 characters, cr+lf
  206.     end;
  207.     // add proper white spaces (formatting)
  208.     while SourcePos > Position do
  209.     begin
  210.       AppendStr(OutStr, ' ');
  211.       Inc(Position);
  212.     end;
  213.     // check the token
  214.     case Token of
  215.       toSymbol: AppendStr(OutStr, TokenString);
  216.       toInteger: AppendStr(OutStr, TokenString);
  217.       toFloat: AppendStr(OutStr, TokenString);
  218.       toOpenTag: if InList(TokenString) then
  219.           AppendStr(OutStr, MakeTagLegal(CorrectLink(TokenString)))
  220.         else AppendStr(OutStr, MakeTagLegal(TokenString));
  221.       toCloseTag: AppendStr(OutStr, MakeTagLegal(TokenString));
  222.       else AppendStr(OutStr, Token);
  223.     end; // case Token of
  224.     // increase the current position
  225.     Position := Position + Length(TokenString);
  226.     // move to the next token
  227.     NextToken;
  228.   end; 
  229.   // add the string to the stream
  230.   Dest.WriteBuffer(Pointer(OutStr)^, Length(OutStr));
  231. end;
  232.  
  233. {$IFDEF DEBUG}
  234. initialization
  235.   AssignFile(Log1, 'c:\temp\debug1.log');
  236.   Rewrite(Log1);
  237. finalization
  238.   CloseFile(Log1);
  239. {$ENDIF}
  240. end.
  241.